HPAVC/HPAVC CD-ROM.iso/pc/UGPRG.ZIP/DENTHOR/TUT17.DOC

Text File | 1996-07-27 | 36.2 KB | 1,133 lines

                   ╒═══════════════════════════════╕
                   │         W E L C O M E         │
                   │  To the VGA Trainer Program   │ │
                   │              By               │ │
                   │      DENTHOR of ASPHYXIA      │ │ │
                   ╘═══════════════════════════════╛ │ │
                     ────────────────────────────────┘ │
                       ────────────────────────────────┘

                           --==[ PART 17 ]==--



=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
■ Introduction

Hi there everybody. It's a new year, but the parties are over and it's time
to get coding again!

My mailserver died. Various sysadmins decided it was time to upgrade the
OS, and wound up nuking the hard drive :-( ... this means that request-list
is not working at the moment, and I have probably lost lots of mail.

[e-mail] is still the account to write to, and
hopefully the mailserver will be back up in the near future.

There are various C/C++ conversions of my trainer, best of which seem to be
those by Snowman ... he runs through the text files with C++ updates (and
seems to point out my previous mistakes with glee ;-), as well is giving a
fully documented C++ conversion of the source ... very nice stuff.

Also, my trainers are being put on a World Wide Web site ... it is still
under construction, but go to http://www.cit.gu.edu.au/~rwong
my site is at http://goth.vironix.co.za/~denthor ... it is currently pretty
awful, anyone want to write a nice one for me? ;)

I have just about finished Asphyxia's new game, I will let you all know
when it is completed.

Tut 16 dies with large bitmaps ... the way to sort this out is to decrease
the accuracy of the fixed point from 256 to 128 ... then you can have
bitmaps up to 512 pixels wide. I will be putting an updated scale routine
in the gfx4.pas unit.

This tutor is on a few demo effects (pixel morphs and static) ... after
this one, I will go on to more theory ... perhaps some more 3d stuff, such
as gourad shading etc. Comments?


If you would like to contact me, or the team, there are many ways you
can do it : 1) Write a message to Grant Smith/Denthor/Asphyxia in private mail
                  on the ASPHYXIA BBS.
            2) Write to :  Grant Smith
                           P.O.Box 270 Kloof
                           3640
                           Natal
                           South Africa
            3) Call me (Grant Smith) at (031) 73 2129 (leave a message if you
                  call during varsity). Call [phone] if you call
                  from outside South Africa. (It's YOUR phone bill ;-))
            4) Write to [e-mail] in E-Mail.
            5) Write to [e-mail] to get to all of
               us at once.

NB : If you are a representative of a company or BBS, and want ASPHYXIA
       to do you a demo, leave mail to me; we can discuss it.
NNB : If you have done/attempted a demo, SEND IT TO ME! We are feeling
        quite lonely and want to meet/help out/exchange code with other demo
        groups. What do you have to lose? Leave a message here and we can work
        out how to transfer it. We really want to hear from you!

=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
■  Pixel Morphing

Have you ever lain down on your back in the grass and looked up at the
cloudy sky? If you have, you have probably seen the clouds move together
and create wonderful shapes ... that cloud plus that cloud together make a
whale ... a ship ... a face etc.

We can't quite outdo mother nature, but we can sure give it a shot. The
effect I am going to show you is where various pixels at different starting
points move together and create an overall picture.

The theory behind it is simple : Each pixel has bits of data associated
with it, most important of which is as follows :

This is my color
This is where I am
This is where I want to be.

The pixel, keeping it's color, goes from where it is to where it wants to
be. Our main problem is _how_ it moves from where it is to where it wants
to be. A obvious approach would be to say "If it's destination is above it,
decrement it's y value, if the destination is to the left, decrement it's x
value and so on."

This would be bad. The pixel would only ever move at set angles, as you can
see below :

                Dest   O-----------------\
                                           \  <--- Path
                                             \
                                               \
                                                O Source

Doesn't look very nice, does it? The pixels would also take different times
to get to their destination, whereas we want them to reach their points at
the same time, ie :

     Dest 1   O-------------------------------O Source 1
     Dest 2   O-----------------O Source 2

Pixels 1 and 2 must get to their destinations at the same time for the best
effect. The way this is done by defining the number of frames or "hops"
needed to get from source to destination. For example, we could tell pixel
one it is allowed 64 hops to get to it's destination, and the same for
point 2, and they would both arrive at the same time, even though pixel 2
is closer.

The next question, it how do we move the pixels in a straight line? This is
easier then you think...

Let us assume that for each pixel, x1,y1 is where it is, and x2,y2 is where
it wants to be.

   (x2-x1) = The distance on the X axis between the two points
   (y2-y1) = The distance on the Y axis between the two points

If we do the following :

  dx := (x2-x1)/64;

we come out with a value in dx wich is very useful. If we added dx to x1 64
times, the result would be x2! Let us check...

  dx = (x2-x1)/64
  dx*64 = x2-x1         { Multiply both sides by 64 }
  dx*64+x1 = x2         { Add x1 to both sides }

This is high school math stuff, and is pretty self explanitory. So what we
have is the x movement for every frame that the pixel has to undergo. We
find the y movement in the same manner.

  dy := (y2-y1)/64;

So our program is as follows :

  Set x1,y1 and x2,y2 values
  dx:= (x2-x1)/64;
  dy:= (y2-y1)/64;

  for loop1:=1 to 64 do BEGIN
    putpixel (x1,y1)
    wait;
    clear pixel (x1,y1);
    x1:=x1+dx;
    y1:=y1+dy;
  END;

If there was a compiler that could use the above pseudocode, it would move
the pixel from x1,y1 to x2,y2 in 64 steps.

So, what we do is set up an array of many pixels with this information, and
move them all at once ... viola, we have pixel morphing! It is usually best
to use a bitmap which defines the color and destination of the pixels, then
randomly scatter them around the screen.

Why not use pixel morphing on a base object in 3d? It would be the work of
a moment to add in a Z axis to the above.

The sample program uses fixed point math in order to achieve high speeds,
but it is basically the above algorithm.


=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
■  Static

A static screen was one of the first effects Asphyxia ever did. We never
actually released it because we couldn't find anywhere it would fit. Maybe
you can.

The easiest way to get a sreen of static is to tune your TV into an unused
station ... you even get the cool noise effect too. Those people who build
TV's really know how to code ;-)

For us on a PC however, it is not as easy to generate a screen full of
static (unless you desperately need a new monitor)

What we do is this :

Set colors 1-16 to various shades of grey.
Fill the screen up with random pixels between colors 1 and 16
Rotate the pallette of colors 1 to 16.

That's it! You have a screenfull of static! To get two images in one static
screen, all you need to do is fade up/down the specific colors you are
using for static in one of the images.

A nice thing about a static screen is that it is just pallette rotations
... you can do lots of things in the foreground at the same time (such as a
scroller).

=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
■  In closing

Well, that is about it ... as I say, I will be doing more theory stuff in
future, as individual demo effects can be thought up if you know the base
stuff.

Note the putpixel in this GFX3.PAS unit ... it is _very_ fast .. but
remember, just calling a procedure eats clock ticks... so imbed putpixels
in your code if you need them. Most of the time a putpixel is not needed
though.

PCGPE ][ will be out on the 10th of Feburary. All the new tutors will be on
it (if you aren't reading this from it right now! ;-) ... grab a copy of
it, it is a very useful ting to have handy.

I have found out that these tutors have been distributed inside paper
magazines ... please remember that Denthor and Asphyxia retain full
copyright to the series (as mentioned earlier in the series), and if you
want to use a version in a magazine, CONTACT ME FIRST ... I will probably
also modify it/cut out various unneccesary things ... other then that, you
must not alter the files without my permission, or at least leave a copy of
the origional with the update. Maybe I could even start up a nice column
for some magazine or other :)

Sorry 'bout that, but it had to be said ...

I am writing a column for the Demuan list, a Florida-based electronic
magazine ... pick it up off ftp.eng.ufl.edu ... I have written various
articles, all bordering on quote-like design.

There are more BBS's to be added to the list at the end, but I don't have
them here... this tut has taken long enough ;-)

Byeeeee....
  - Denthor

The following are official ASPHYXIA distribution sites :

╔══════════════════════════╦════════════════╦═════╗
║BBS Name                  ║Telephone No.   ║Open ║
╠══════════════════════════╬════════════════╬═════╣
║ASPHYXIA BBS #1           ║[phone] ║ALL  ║
║ASPHYXIA BBS #2           ║[phone] ║ALL  ║
║C-Spam BBS                ║410-531-5886    ║ALL  ║
║POP!                      ║[phone] ║ALL  ║
║Soul Asylum               ║[phone]  ║ALL  ║
║Wasted Image              ║407-838-4525    ║ALL  ║
║Reckless Life             ║351-01-716 67 58║ALL  ║
║Mach 5 BBS                ║[phone] ║ALL  ║
╚══════════════════════════╩════════════════╩═════╝

Leave me mail if you want to become an official Asphyxia BBS
distribution site.
{$X+}
USES crt,gfx3;

Const jump = 64;       { Number of pixels active at once }
      sjump = 6;       { 1 shl 6 = 64 }

TYPE
        FontDat = Array [' '..'Z',1..16,1..16] of byte; {Our main font }
        target = record
                 herex,herey : integer;
                 targx,targy : integer;
                 dy,dx : integer;
                 active : boolean;
                 col : byte;
                 num:integer;
             END;
        PixelDat = Array [1..4095] of target; { This is the maximum number
                                                of points we canb fit in a
                                                segment... }

VAR Font : ^FontDat;                          { Our nice font }
    nextrow : ^PixelDat;
    scr : array [' '..'Z',1..8,1..8] of byte; { The basic bios font }
    Vir2 : VirtPtr;
    Vaddr2 : Word;                            { Spare virtual screen }
    counter:integer;
    PosLoop:integer;
    dir : boolean;
    pathx,pathy:array [1..314] of integer;    { Path of origination }
    arbpal : array [1..8,1..3] of byte;       { Used to remember certain
                                                colors }



{──────────────────────────────────────────────────────────────────────────}
Procedure Bigmsg (x,y:integer;msg:string);
  { This draws string msg to screen in the bios font, but bigger }
VAR loop1,loop2,loop3,loop4,loop5:integer;
BEGIN
  for loop1:=1 to length (msg) do
    for loop2:=1 to 8 do
      for loop3:=1 to 8 do
        if (scr[msg[loop1],loop3,loop2]<>0) then BEGIN
          for loop4:=1 to 4 do
            for loop5:=1 to 8 do
              putpixel (x+(loop1*32)+(loop2*4)+loop4,y+(loop3*8)+loop5,
                getpixel (x+(loop1*32)+(loop2*4)+loop4,y+(loop3*8)+loop5,vaddr2)+51,vaddr);
        END;
END;




{──────────────────────────────────────────────────────────────────────────}
Procedure Static;
  { This moves the static and tunes in to our background logo }
VAR loop1,loop2,count,count2,count3:integer;
BEGIN
  flip (vaddr2,vaddr);
  Bigmsg (0,60,'ASPHYXIA');
  flip (vaddr,vga);
  count:=0;
  count2:=0;
  for loop2:=1 to 100 do BEGIN
    waitretrace;
    for loop1:=99 to 150 do BEGIN
      count:=random (64);
      pal (loop1,count,count,count);
    END;
    for loop1:=150 to 201 do BEGIN
      count:=random (64);
      pal (loop1,count,count,count);
    END;
  END;   { Do the static for a while }

  repeat
    inc (count);
    if count>10 then BEGIN
      count:=0;
      inc (count2);
    END;
    waitretrace;
    for loop1:=99 to 150 do BEGIN
      count3:=random (64-count2);
      if count3<0 then count3:=0;
      pal (loop1,count3,count3,count3);
    END;
    for loop1:=150 to 201 do BEGIN
      count3:=random (64);
      count3:=count3+count2;
      if count3>63 then count3:=63;
      pal (loop1,count3,count3,count3);
    END;
  until count2>63; { Static fade in Asphyxia logo }

  delay (500);
  for loop1:=30 to 62 do BEGIN
    line (0,loop1*2,319,loop1*2,0,vga);
    delay (5);
  END;
  for loop1:=62 downto 30 do BEGIN
    line (0,loop1*2+1,319,loop1*2+1,0,vga);
    delay (5);
  END;  { Erase logo with lines }
  delay (1000);
  while keypressed do readkey;
END;


{──────────────────────────────────────────────────────────────────────────}
Procedure Fadeup;
  { This fades up the pallette to white }
VAR loop1,loop2:integer;
    Tmp : Array [1..3] of byte;
BEGIN
  For loop1:=1 to 64 do BEGIN
    WaitRetrace;
    For loop2:=0 to 255 do BEGIN
      Getpal (loop2,Tmp[1],Tmp[2],Tmp[3]);
      If Tmp[1]<63 then inc (Tmp[1]);
      If Tmp[2]<63 then inc (Tmp[2]);
      If Tmp[3]<63 then inc (Tmp[3]);
      Pal (loop2,Tmp[1],Tmp[2],Tmp[3]);
    END;
  END;
END;


{──────────────────────────────────────────────────────────────────────────}
Procedure FadeTo (name:string);
  { This procedure fades the screen to name ... if you use this for yourself,
    you will need to cut out the extra stuff I do in here specific to this
    program }
VAR loop1,loop2:integer;
    tmp,pall2:array[0..255,1..3] of byte;
    f:file;
BEGIN
  assign (f,name);
  reset (f,1);
  blockread (f,pall2,768);
  close (f);
  for loop1:=100 to 150 do BEGIN
    pall2[loop1,1]:=loop1-100;
    pall2[loop1,2]:=loop1-100;
    pall2[loop1,3]:=loop1-100;
  END;  { Set the background colors }
  waitretrace;
  for loop1:=0 to 255 do
    getpal (loop1,tmp[loop1,1],tmp[loop1,2],tmp[loop1,3]);

  For loop1:=1 to 64 do BEGIN
    For loop2:=0 to 255 do BEGIN
      If Tmp[loop2,1]<Pall2[loop2,1] then inc (Tmp[loop2,1]);
      If Tmp[loop2,2]<Pall2[loop2,2] then inc (Tmp[loop2,2]);
      If Tmp[loop2,3]<Pall2[loop2,3] then inc (Tmp[loop2,3]);
      If Tmp[loop2,1]>Pall2[loop2,1] then dec (Tmp[loop2,1]);
      If Tmp[loop2,2]>Pall2[loop2,2] then dec (Tmp[loop2,2]);
      If Tmp[loop2,3]>Pall2[loop2,3] then dec (Tmp[loop2,3]);
    END;
    WaitRetrace;
    for loop2:=0 to 255 do
      pal (loop2,tmp[loop2,1],tmp[loop2,2],tmp[loop2,3]);
  END;
END;


{──────────────────────────────────────────────────────────────────────────}
Procedure Show (x,y:integer;ch:string);
  { This dumps string ch to screen at x,y in our main font }
VAR loop1,loop2,loop3:integer;
BEGIN
  for loop3:=1 to length (ch) do
    For loop1:=1 to 16 do
      for loop2:=1 to 16 do
        if Font^[ch[loop3],loop2,loop1]<>0 then
          putpixel (x+loop1+(loop3*17),y+loop2,getpixel (x+loop1+(loop3*17),y+loop2,vaddr2)+51,VGA);
END;


{──────────────────────────────────────────────────────────────────────────}
Procedure Eye_Popper;
  { This fades up the colors used in our main font }
VAR Loop1,loop2:integer;
    tmp : array [1..3] of byte;
BEGIN
  if keypressed then exit;
  for loop1:=1 to 63 do
    for loop2:=1 to 8 do BEGIN
      Waitretrace;
      Getpal (loop2,tmp[1],tmp[2],tmp[3]);
      if tmp[1]<63 then inc (tmp[1]);
      if tmp[2]<63 then inc (tmp[2]);
      if tmp[3]<63 then inc (tmp[3]);
      pal (loop2,tmp[1],tmp[2],tmp[3]);
    END;
  for loop1:=151 to 200 do
    pal (loop1,63,63,63);
END;


{──────────────────────────────────────────────────────────────────────────}
Procedure FadeOutText;
  { This fades out the colors of our main font to the colors of the background
    static }
VAR Loop1,loop2:integer;
    tmp : array [1..3] of byte;
BEGIN
  if keypressed then exit;
  for loop1:=1 to 63 do BEGIN
    Waitretrace;
    for loop2:=151 to 200 do BEGIN
      Getpal (loop2,tmp[1],tmp[2],tmp[3]);
      if tmp[1]>loop2-151 then dec (tmp[1]);
      if tmp[2]>loop2-151 then dec (tmp[2]);
      if tmp[3]>loop2-151 then dec (tmp[3]);
      pal (loop2,tmp[1],tmp[2],tmp[3]);
    END;
  END;
  delay (100);
END;


{──────────────────────────────────────────────────────────────────────────}
Procedure Move_Em_Out (num:integer;del:byte);
  { This procedure runs through each pixel that is active and moves it closer
    to its destination }
VAR loop2:integer;
BEGIN
  if del<>0 then delay (del);
  for loop2:=1 to num do
    if nextrow^[loop2].active then with nextrow^[loop2] do BEGIN
      putpixel (herex shr sjump,herey shr sjump,
                getpixel (herex shr sjump,herey shr sjump,vaddr),vga);
        { Restore old bacground }
      herex:=herex-dx;
      herey:=herey-dy;  { Move pixel one step closer }
      putpixel (herex shr sjump,herey shr sjump,col,vga); { Put down pixel }
      dec (num);
      if num=0 then BEGIN
        active:=false;
        putpixel (herex shr sjump,herey shr sjump,col,vaddr);
      END;  { If destination reached, deactivate }
    END;
END;


{──────────────────────────────────────────────────────────────────────────}
Procedure Doletter (msg : char; dx,dy : integer);
  { This procedure activates the pixels necessary to draw a letter }
VAR loop1,loop2:integer;
    x,y : Integer;
BEGIN
  if keypressed then exit;
  for loop2:=1 to 16 do BEGIN
    for loop1:=1 to 16 do     { Our font is 16x16 }
      if Font^[msg,loop1,loop2]<>0 then BEGIN { Don't do black pixels }
        if dir then PosLoop:=PosLoop+1
          else PosLoop:=PosLoop-1;
        if PosLoop=315 then PosLoop:=1;
        if PosLoop=0 then PosLoop:=314;
        X:=pathx[PosLoop]+160;
        y:=pathy[PosLoop]+100;     { Find point of origination }

        nextrow^ [counter].herex:=x shl sjump;
        nextrow^ [counter].herey:=y shl sjump;
          { This is where I am }
        nextrow^ [counter].targx:=(dx+loop2) shl sjump;
        nextrow^ [counter].targy:=(dy+loop1) shl sjump;
          { This is where I want to be }
        nextrow^ [counter].dx:=(nextrow^[counter].herex-nextrow^[counter].targx) div jump;
        nextrow^ [counter].dy:=(nextrow^[counter].herey-nextrow^[counter].targy) div jump;
          { This is how I get there }
        nextrow^ [counter].col:=Font^[msg,loop1,loop2];
        nextrow^ [counter].active:=TRUE;
        nextrow^ [counter].num:=jump;
        move_em_out(jump,6);

        inc (counter);
        if counter=jump+1 then counter:=1;
      END;
  END;
END;



{──────────────────────────────────────────────────────────────────────────}
Procedure DoPic;
  { This procedure morphs in the tank }
VAR f:file;
    ch:byte;
    count,loop1,loop2:integer;
    ourpal : array [0..255,1..3] of byte;
BEGIN
  cls (vaddr,0);
  getmem (nextrow,sizeof(nextrow^));
  GetMem(Vir2,64000);
  Vaddr2 := Seg(Vir2^);
  for loop2:=1 to 4095 do
    nextrow^[loop2].active:=false;

  assign (f,'tut17.cel');
  reset (f,1);
  seek (f,32);
  blockread (f,ourpal,768);
  for loop1:=0 to 255 do
    pal (loop1,ourpal[loop1,1],ourpal[loop1,2],ourpal[loop1,3]);
  count:=1;
  for loop2:=1 to 60 do
    for loop1:=1 to 160 do BEGIN
      blockread (f,ch,1);     { Go through the pic, and activate non-black
                                pixels }
      if ch<>0 then BEGIN
        nextrow^ [count].herex:=random (320) shl sjump;
        nextrow^ [count].herey:=random (200) shl sjump;
          { This is where I am }
        nextrow^ [count].targx:=(loop1+80) shl sjump;
        nextrow^ [count].targy:=(loop2+70) shl sjump;
          { This is where I want to be }
        nextrow^ [count].dx:=(nextrow^[count].herex-nextrow^[count].targx) div jump;
        nextrow^ [count].dy:=(nextrow^[count].herey-nextrow^[count].targy) div jump;
          { This is how I get there }
        nextrow^ [count].col:=ch;
        nextrow^ [count].active:=TRUE;
        nextrow^ [count].num:=jump;
        inc (count);
      END;
  END;
  close (f);
  for loop1:=0 to 64 do
    move_em_out (count,0);  { Move pixels to targets }
  delay (2000);
  fadeup;
END;

{──────────────────────────────────────────────────────────────────────────}
Procedure Init;
VAR f:file;
    loop1,loop2:integer;
    loopie:real;
BEGIN
  getmem (Font,sizeof(Font^));

  for loop2:=1 to jump do
    nextrow^[loop2].active:=false;

  Assign(f,'gods.Fnt');
  Reset(f,1);
  Blockread(F,Font^,SizeOf(Font^));
  Close(f);

  assign (f,'biostext.dat');
  reset (f,1);
  Blockread (f,scr,sizeof (scr));
  close (f);

  counter:=1;
  PosLoop:=1;
  dir:=true;
  loopie:=0;
  for loop1:=1 to 314 do BEGIN
    loopie:=loopie+0.02;
    pathX[loop1]:=round(150*cos (loopie));
    pathy[loop1]:=round(90*sin (loopie));
  END;    { Generate our path of origination }
  cls (vga,0);
  cls (vaddr,0);
  cls (vaddr2,0);
  for loop1:=0 to 319 do
    for loop2:=0 to 199 do
      putpixel (loop1,loop2,random (50)+100,vaddr2); { Fill the screen with static }
  flip (vaddr2,vaddr);
  flip (vaddr,vga);
  fadeto ('game01.col');
  for loop1:=1 to 8 do
    getpal (loop1,arbpal[loop1,1],arbpal[loop1,2],arbpal[loop1,3]);
END;


{──────────────────────────────────────────────────────────────────────────}
Procedure Play;
VAR loop1,loop2:integer;
    message : Array [1..10] of string;
BEGIN
  DoPic;
  init;
  while keypressed do readkey;
             {[                 ]}
  message[1]:='';
  message[2]:='';
  message[3]:='   PIXEL TEXT   ';
  message[4]:='';
  message[5]:='   A  ROUTINE';
  message[6]:='';
  message[7]:='      BY...';
  message[9]:='';
 message[10]:='';
  for loop2:=1 to 7 do BEGIN
    For loop1:=1 to length (message[loop2]) do BEGIN
      doletter (message[loop2][loop1],loop1*17,loop2*17);
      dir:=not(dir);
    END;
    for loop1:=1 to jump do move_em_out(jump,6);
  END;

  eye_popper;
  For loop1:=1 to 7 do
    show (0,loop1*17,message[loop1]);
  fadeouttext;
  flip (vaddr2,vaddr);
  flip (vaddr,vga);

  for loop1:=1 to 8 do
    pal (loop1,arbpal[loop1,1],arbpal[loop1,2],arbpal[loop1,3]);
  message[1]:='   TUNING...';
  For loop1:=1 to length (message[1]) do BEGIN
    if message[1][loop1]='.' then for loop2:=1 to 20 do
      move_em_out(jump,6);
    doletter (message[1][loop1],loop1*17,100);
    dir:=not(dir);
  END;
  for loop1:=1 to jump do move_em_out(jump,6);

  eye_popper;
  show (0,100,message[1]);
  fadeouttext;

  static;

  freemem (vir2,sizeof (vir2^));
END;


BEGIN
  clrscr;
  writeln ('Hi there ... welcome to the seventeenth Asphyxia VGA Trainer ... and');
  writeln ('the last one on demo effects for a while ... I am going to be doing');
  writeln ('more work on the theory aspect in future trainers.');
  writeln;
  writeln ('This is an effect I first saw in an Extreme demo, and features ''Pixel');
  writeln ('Text'', with various dots forming letters. Also included are some crossfades');
  writeln ('and a static routine.');
  writeln;
  writeln ('Check out the GFX3 unit for a faster putpixel...');
  writeln;
  writeln ('The tank was drawn by Fubar a while ago when he was starting to learn');
  writeln ('3D Studio. The font I found somewhere on my hard drive.');
  writeln;
  writeln;
  writeln ('Hit any key to continue ...');
  readkey;
  setmcga;
  setupvirtual;
  play;
  settext;
  shutdown;
  Writeln ('All done. This concludes the seventeenth sample program in the ASPHYXIA');
  Writeln ('Training series. You may reach DENTHOR under the names of GRANT');
  Writeln ('SMITH/DENTHOR/ASPHYXIA on the ASPHYXIA BBS.I also occasinally read');
  Writeln ('RSAProg, comp.lang.pascal and comp.sys.ibm.pc.demos. E-mail me at :');
  Writeln ('    [e-mail]');
  Writeln ('The numbers are available in the main text. You may also write to me at:');
  Writeln ('             Grant Smith');
  Writeln ('             P.O. Box 270');
  Writeln ('             Kloof');
  Writeln ('             3640');
  Writeln ('             Natal');
  Writeln ('             South Africa');
  Writeln ('I hope to hear from you soon!');
  Writeln; Writeln;
  Write   ('Hit any key to exit ...');
  readkey;
END.Unit GFX3;


INTERFACE

USES crt;
CONST VGA = $A000;

TYPE Virtual = Array [1..64000] of byte;  { The size of our Virtual Screen }
     VirtPtr = ^Virtual;                  { Pointer to the virtual screen }

VAR Virscr : VirtPtr;                     { Our first Virtual screen }
    Vaddr  : word;                        { The segment of our virtual screen}
    Scr_Ofs : Array[0..199] of Word;

Procedure SetMCGA;
   { This procedure gets you into 320x200x256 mode. }
Procedure SetText;
   { This procedure returns you to text mode.  }
Procedure Cls (Where:word;Col : Byte);
   { This clears the screen to the specified color }
Procedure SetUpVirtual;
   { This sets up the memory needed for the virtual screen }
Procedure ShutDown;
   { This frees the memory used by the virtual screen }
procedure flip(source,dest:Word);
   { This copies the entire screen at "source" to destination }
Procedure Pal(Col,R,G,B : Byte);
   { This sets the Red, Green and Blue values of a certain color }
Procedure GetPal(Col : Byte; Var R,G,B : Byte);
  { This gets the Red, Green and Blue values of a certain color }
procedure WaitRetrace;
   {  This waits for a vertical retrace to reduce snow on the screen }
Procedure Hline (x1,x2,y:word;col:byte;where:word);
   { This draws a horizontal line from x1 to x2 on line y in color col }
Procedure Line(a,b,c,d:integer;col:byte;where:word);
  { This draws a solid line from a,b to c,d in colour col }
Procedure DrawPoly(x1,y1,x2,y2,x3,y3,x4,y4:integer;color:byte;where:word);
   { This draw a polygon with 4 points at x1,y1 , x2,y2 , x3,y3 , x4,y4
     in color col }
Function rad (theta : real) : real;
   {  This calculates the degrees of an angle }
Procedure Putpixel (X,Y : Integer; Col : Byte; where:word);
   { This puts a pixel on the screen by writing directly to memory. }
Function Getpixel (X,Y : Integer; where:word) :Byte;
   { This gets the pixel on the screen by reading directly to memory. }
Procedure LoadCEL (FileName :  string; ScrPtr : pointer);
  { This loads the cel 'filename' into the pointer scrptr }
Procedure LoadPal (FileName : string);
  { This loads in an Autodesk Animator V1 pallette file }

IMPLEMENTATION

{──────────────────────────────────────────────────────────────────────────}
Procedure SetMCGA;  { This procedure gets you into 320x200x256 mode. }
BEGIN
  asm
     mov        ax,0013h
     int        10h
  end;
END;

{──────────────────────────────────────────────────────────────────────────}
Procedure SetText;  { This procedure returns you to text mode.  }
BEGIN
  asm
     mov        ax,0003h
     int        10h
  end;
END;

{──────────────────────────────────────────────────────────────────────────}
Procedure Cls (Where:word;Col : Byte); assembler;
   { This clears the screen to the specified color }
asm
   push    es
   mov     cx, 32000;
   mov     es,[where]
   xor     di,di
   mov     al,[col]
   mov     ah,al
   rep     stosw
   pop     es
End;

{──────────────────────────────────────────────────────────────────────────}
Procedure SetUpVirtual;
   { This sets up the memory needed for the virtual screen }
BEGIN
  GetMem (VirScr,64000);
  vaddr := seg (virscr^);
END;

{──────────────────────────────────────────────────────────────────────────}
Procedure ShutDown;
   { This frees the memory used by the virtual screen }
BEGIN
  FreeMem (VirScr,64000);
END;

{──────────────────────────────────────────────────────────────────────────}
procedure flip(source,dest:Word); assembler;
  { This copies the entire screen at "source" to destination }
asm
  push    ds
  mov     ax, [Dest]
  mov     es, ax
  mov     ax, [Source]
  mov     ds, ax
  xor     si, si
  xor     di, di
  mov     cx, 32000
  rep     movsw
  pop     ds
end;

{──────────────────────────────────────────────────────────────────────────}
Procedure Pal(Col,R,G,B : Byte); assembler;
  { This sets the Red, Green and Blue values of a certain color }
asm
   mov    dx,3c8h
   mov    al,[col]
   out    dx,al
   inc    dx
   mov    al,[r]
   out    dx,al
   mov    al,[g]
   out    dx,al
   mov    al,[b]
   out    dx,al
end;

{──────────────────────────────────────────────────────────────────────────}
Procedure GetPal(Col : Byte; Var R,G,B : Byte);
  { This gets the Red, Green and Blue values of a certain color }
Var
   rr,gg,bb : Byte;
Begin
   asm
      mov    dx,3c7h
      mov    al,col
      out    dx,al

      add    dx,2

      in     al,dx
      mov    [rr],al
      in     al,dx
      mov    [gg],al
      in     al,dx
      mov    [bb],al
   end;
   r := rr;
   g := gg;
   b := bb;
end;

{──────────────────────────────────────────────────────────────────────────}
procedure WaitRetrace; assembler;
  {  This waits for a vertical retrace to reduce snow on the screen }
label
  l1, l2;
asm
    mov dx,3DAh
l1:
    in al,dx
    and al,08h
    jnz l1
l2:
    in al,dx
    and al,08h
    jz  l2
end;

{──────────────────────────────────────────────────────────────────────────}
Procedure Hline (x1,x2,y:word;col:byte;where:word); assembler;
  { This draws a horizontal line from x1 to x2 on line y in color col }
asm
  mov   ax,where
  mov   es,ax
  mov   ax,y
  mov   di,ax
  shl   ax,8
  shl   di,6
  add   di,ax
  add   di,x1

  mov   al,col
  mov   ah,al
  mov   cx,x2
  sub   cx,x1
  shr   cx,1
  jnc   @start
  stosb
@Start :
  rep   stosw
end;

{──────────────────────────────────────────────────────────────────────────}
Procedure Line(a,b,c,d:integer;col:byte;where:word);
  { This draws a solid line from a,b to c,d in colour col }
  function sgn(a:real):integer;
  begin
       if a>0 then sgn:=+1;
       if a<0 then sgn:=-1;
       if a=0 then sgn:=0;
  end;
var i,s,d1x,d1y,d2x,d2y,u,v,m,n:integer;
begin
     u:= c - a;
     v:= d - b;
     d1x:= SGN(u);
     d1y:= SGN(v);
     d2x:= SGN(u);
     d2y:= 0;
     m:= ABS(u);
     n := ABS(v);
     IF NOT (M>N) then
     BEGIN
          d2x := 0 ;
          d2y := SGN(v);
          m := ABS(v);
          n := ABS(u);
     END;
     s := m shr 1;
     FOR i := 0 TO m DO
     BEGIN
          putpixel(a,b,col,where);
          s := s + n;
          IF not (s<m) THEN
          BEGIN
               s := s - m;
               a:= a + d1x;
               b := b + d1y;
          END
          ELSE
          BEGIN
               a := a + d2x;
               b := b + d2y;
          END;
     end;
END;


{──────────────────────────────────────────────────────────────────────────}
Procedure DrawPoly(x1,y1,x2,y2,x3,y3,x4,y4:integer;color:byte;where:word);
  { This draw a polygon with 4 points at x1,y1 , x2,y2 , x3,y3 , x4,y4
    in color col }
var
  x:integer;
  mny,mxy:integer;
  mnx,mxx,yc:integer;
  mul1,div1,
  mul2,div2,
  mul3,div3,
  mul4,div4:integer;

begin
  mny:=y1; mxy:=y1;
  if y2<mny then mny:=y2;
  if y2>mxy then mxy:=y2;
  if y3<mny then mny:=y3;
  if y3>mxy then mxy:=y3;    { Choose the min y mny and max y mxy }
  if y4<mny then mny:=y4;
  if y4>mxy then mxy:=y4;

  if mny<0 then mny:=0;
  if mxy>199 then mxy:=199;
  if mny>199 then exit;
  if mxy<0 then exit;        { Verticle range checking }

  mul1:=x1-x4; div1:=y1-y4;
  mul2:=x2-x1; div2:=y2-y1;
  mul3:=x3-x2; div3:=y3-y2;
  mul4:=x4-x3; div4:=y4-y3;  { Constansts needed for intersection calc }

  for yc:=mny to mxy do
    begin
      mnx:=320;
      mxx:=-1;
      if (y4>=yc) or (y1>=yc) then
        if (y4<=yc) or (y1<=yc) then   { Check that yc is between y1 and y4 }
          if not(y4=y1) then
            begin
              x:=(yc-y4)*mul1 div div1+x4; { Point of intersection on x axis }
              if x<mnx then
                mnx:=x;
              if x>mxx then
                mxx:=x;       { Set point as start or end of horiz line }
            end;
      if (y1>=yc) or (y2>=yc) then
        if (y1<=yc) or (y2<=yc) then   { Check that yc is between y1 and y2 }
          if not(y1=y2) then
            begin
              x:=(yc-y1)*mul2 div div2+x1; { Point of intersection on x axis }
              if x<mnx then
                mnx:=x;
              if x>mxx then
                mxx:=x;       { Set point as start or end of horiz line }
            end;
      if (y2>=yc) or (y3>=yc) then
        if (y2<=yc) or (y3<=yc) then   { Check that yc is between y2 and y3 }
          if not(y2=y3) then
            begin
              x:=(yc-y2)*mul3 div div3+x2; { Point of intersection on x axis }
              if x<mnx then
                mnx:=x;
              if x>mxx then
                mxx:=x;       { Set point as start or end of horiz line }
            end;
      if (y3>=yc) or (y4>=yc) then
        if (y3<=yc) or (y4<=yc) then   { Check that yc is between y3 and y4 }
          if not(y3=y4) then
            begin
              x:=(yc-y3)*mul4 div div4+x3; { Point of intersection on x axis }
              if x<mnx then
                mnx:=x;
              if x>mxx then
                mxx:=x;       { Set point as start or end of horiz line }
            end;
      if mnx<0 then
        mnx:=0;
      if mxx>319 then
        mxx:=319;          { Range checking on horizontal line }
      if mnx<=mxx then
        hline (mnx,mxx,yc,color,where);   { Draw the horizontal line }
    end;
  end;

{──────────────────────────────────────────────────────────────────────────}
Function rad (theta : real) : real;
  {  This calculates the degrees of an angle }
BEGIN
  rad := theta * pi / 180
END;

{──────────────────────────────────────────────────────────────────────────}
Procedure Putpixel (X,Y : Integer; Col : Byte; where:word); assembler;
  { This puts a pixel on the screen by writing directly to memory. }
asm
   mov  ax,where
   mov  es,ax
   mov  bx,[y]
   shl  bx,1
   mov  di,word ptr [Scr_Ofs + bx]
   add  di,[x]
   mov  al,[col]
   mov  es:[di],al
end;


{──────────────────────────────────────────────────────────────────────────}
Function Getpixel (X,Y : Integer; where:word):byte; assembler;
  { This puts a pixel on the screen by writing directly to memory. }
asm
   mov  ax,where
   mov  es,ax
   mov  bx,[y]
   shl  bx,1
   mov  di,word ptr [Scr_Ofs + bx]
   add  di,[x]
   mov  al,es:[di]
end;

{──────────────────────────────────────────────────────────────────────────}
Procedure LoadCEL (FileName :  string; ScrPtr : pointer);
  { This loads the cel 'filename' into the pointer scrptr }
var
  Fil : file;
  Buf : array [1..1024] of byte;
  BlocksRead, Count : word;
begin
  assign (Fil, FileName);
  reset (Fil, 1);
  BlockRead (Fil, Buf, 800);    { Read and ignore the 800 byte header }
  Count := 0;
  BlocksRead := $FFFF;
  while (not eof (Fil)) and (BlocksRead <> 0) do begin
    BlockRead (Fil, mem [seg (ScrPtr^): ofs (ScrPtr^) + Count], 1024, BlocksRead);
    Count := Count + 1024;
  end;
  close (Fil);
end;


procedure LoadPal (FileName : string);
var
  F:file;
  loop1:integer;
  pall:array[0..255,1..3] of byte;
begin
  assign (F, FileName);
  reset (F,1);
  blockread (F, pall,768);
  close (F);
  for loop1 := 0 to 255 do
    Pal(loop1,pall[loop1,1],pall[loop1,2],pall[loop1,3]);
end;


VAR Loop1:integer;

BEGIN
  For Loop1 := 0 to 199 do
    Scr_Ofs[Loop1] := Loop1 * 320;
END.